Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/toolkit/riruf1/rufdemo.frm

Visual Basic Form | 1995-05-19 | 9.5 KB | 298 lines

VERSION 2.00
Begin Form RUFMain
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   5385
   ClientLeft      =   1065
   ClientTop       =   1395
   ClientWidth     =   7455
   Height          =   6075
   Icon            =   RUFDEMO.FRX:0000
   Left            =   1005
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5385
   ScaleWidth      =   7455
   Top             =   765
   Width           =   7575
   Begin SSFrame Frame3D2
      Font3D          =   0  'None
      ForeColor       =   &H00000000&
      Height          =   3975
      Left            =   120
      TabIndex        =   2
      Top             =   1320
      Width           =   7215
      Begin Label lblInfo
         BackColor       =   &H00C0C0C0&
         Caption         =   "Information"
         ForeColor       =   &H00FF0000&
         Height          =   3615
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   6975
      End
   End
   Begin SSFrame Frame3D1
      Font3D          =   0  'None
      ForeColor       =   &H00000000&
      Height          =   1215
      Left            =   120
      TabIndex        =   1
      Top             =   0
      Width           =   7215
      Begin Label lblTitle
         Alignment       =   2  'Center
         BackColor       =   &H00C0C0C0&
         Caption         =   "MIS Resources International, Inc"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   18
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000080&
         Height          =   975
         Left            =   120
         TabIndex        =   0
         Top             =   120
         Width           =   6975
      End
   End
   Begin Menu mainMenu
      Caption         =   "&File"
      Index           =   1
      Begin Menu fileMenu
         Caption         =   "&Logon..."
         Index           =   1
      End
      Begin Menu fileMenu
         Caption         =   "&Compact Database"
         Index           =   2
      End
      Begin Menu fileMenu
         Caption         =   "&Select Database..."
         Index           =   3
      End
      Begin Menu fileMenu
         Caption         =   "E&xit"
         Index           =   4
      End
   End
   Begin Menu mainMenu
      Caption         =   "&Data"
      Index           =   2
      Begin Menu dataMenu
         Caption         =   "&Employee Data..."
         Index           =   1
      End
      Begin Menu dataMenu
         Caption         =   "Employee &Statuses..."
         Index           =   2
      End
   End
   Begin Menu mainMenu
      Caption         =   "&Send Mail"
      Index           =   3
      Visible         =   0   'False
   End
   Begin Menu mainMenu
      Caption         =   "&Help"
      Index           =   4
      Begin Menu helpMenu
         Caption         =   "&Help Contents"
         Index           =   1
         Shortcut        =   {F1}
      End
      Begin Menu helpMenu
         Caption         =   "&Search For Help On..."
         Index           =   2
      End
      Begin Menu helpMenu
         Caption         =   "&About..."
         Index           =   3
      End
      Begin Menu helpMenu
         Caption         =   "&Shareware Version"
         Checked         =   -1  'True
         Index           =   4
      End
      Begin Menu helpMenu
         Caption         =   "&Other Features"
         Index           =   5
      End
   End
Option Explicit
'menu constants
Const MCLOGON% = 1
Const MCCOMPACT% = 2
Const MCDATABASE% = 3
Const MCEXIT% = 4
Const MCCONTENTS% = 1
Const MCSEARCHHELP% = 2
Const MCABOUT% = 3
Const MCSWV% = 4
Const MCOTHER% = 5
Const MCEMPLOYEES% = 1
Const MCEMPSTATUS% = 2
Function CheckPassword% ()
    On Error GoTo passErr
    Dim sTmp$
    HourglassCursor
    'lookup the users password here
    sTmp = "RUF"
    'here we compare; passwords are case insensitive
    If StrComp(sTmp, sPassword, 1) = 0 Then
        sPassword = sTmp
        CheckPassword = True
    Else
        CheckPassword = False
    End If
    ArrowCursor
    Exit Function
passErr:
    ArrowCursor
    GetErrorMsg Err
    Exit Function
End Function
Sub dataMenu_Click (Index As Integer)
    Select Case Index
        Case MCEMPLOYEES
            lblInfo.Caption = LoadText("empform.txt")
            ModalForm Empform
        Case MCEMPSTATUS
            lblInfo.Caption = LoadText("auxedit.txt")
            'set the properties of the rufauxedit form
            sRUFAuxTable = "EmpStatus" 'table for RufAuxEdForm
            lRUFAuxEdHelpID = Auxiluary_Table_Edit_Form 'help ID for RufAuxEdForm
            sRUFAuxIDCaption = "Status Number" 'ID caption for RufAuxEdForm
            sRUFAuxLable = "Employee Status" 'label caption for RufAuxEdForm
            sRUFAuxCaption = "Employee Statuses" 'form caption for RufAuxEdForm
            sRUFAuxQuery = "GetStatusRec" 'query def for RufAuxEdForm
            sRUFAuxDelCheckQuery = "CheckStatusID" 'query to check for clearence to delete a record
            sRUFAuxDelQuery = "DeleteStatusID" 'query to delete a record
            bRUFAuxDelete = True 'boolen value to set the enable property of cmdDelete button
            sRUFAuxLoad = "GetAllStatuses" 'query def for loading the list box
            sRUFAuxFields(0) = "StatusNo"
            sRUFAuxFields(1) = "StatusType"
            sRUFAuxFields(2) = "Active"
            ModalForm RufAuxEdForm
    End Select
End Sub
Sub fileMenu_Click (Index As Integer)
    Select Case Index
        Case MCLOGON
            'display the logon form, collect username and password,
            'validate the password
            lblInfo.Caption = LoadText("login.txt")
            ModalForm RufLogin
            If bLogin Then
                While Not CheckPassword() And bLogin
                    StopUser "Invalid login!"
                    ModalForm RufLogin
                    If Not bLogin Then
                        'we could end the program here
                        'End
                    Else
                    End If
                Wend
            Else
                'we could end the program here also
                'End
            End If
        Case MCCOMPACT
            lblInfo.Caption = LoadText("compact.txt")
            'compact the access database file
            TheDatabase.Close
            DoEvents
            CompactDB sDBName
            OpenDB
        Case MCDATABASE
            lblInfo.Caption = LoadText("seldb.txt")
            'select the database
            'tell RufDBForm not to end the program if
            'the cancel button is pressed
            bRufDbEnd = False
            'set the change flag to false
            bDBChange = False
            ModalForm RUFDBForm
            'if changed close the database and open the new selection
            If bDBChange Then
                DoEvents
                TheDatabase.Close
                OpenDB
            End If
        Case MCEXIT
            'exit the program
            Unload RufMain
    End Select
End Sub
Sub Form_Load ()
    On Error GoTo loaderr
    Dim sWave$, sTitle$
    Set MainForm = RufMain
    'allow only one instance of the program to run at a time
    FindProgram TheAppTitle
    'set the main window title only after the FindProgram function
    RufMain.Caption = TheAppTitle
    RufMain.Show
    'initialize the message box module
    InitMB TheAppTitle
    'initialize the .ini file module
    InitIni TheAppTitle, "rufdemo.ini"
    'initialize the help module
    InitHelp "rufdemo.hlp", RufMain.hWnd
    'center the form
    CenterFromScreen RufMain
    'get the database & path from the .ini file
    sDBPath = GetFromIni("Database", 100)
    'if not listed in .ini file, try the current directory
    If Len(LTrim$(sDBPath)) < 1 Then
        sDBPath = CurDir$ & "\" & UCase$(sDBName)
    End If
    'open the database
    OpenDB
    SetSystemDB "RufDemoSystem"
    sTitle = "MIS Resources International, Inc" + Chr(10) + Chr(13)
    sTitle = sTitle & "Reusable Functions Demo Program"
    lblTitle.Caption = sTitle
    lblInfo.Caption = LoadText("intro.txt")
    If CheckCmdLine("wave") Then
        sWave = CurDir$ & "\cont1.wav"
        PlaySound sWave
    End If
    Exit Sub
loaderr:
    ArrowCursor
    GetErrorMsg Err
    Exit Sub
End Sub
Sub Form_Unload (cancel As Integer)
    EndHelp
End Sub
Sub helpMenu_Click (Index As Integer)
    Select Case Index
        Case MCCONTENTS
            lblInfo.Caption = LoadText("helptext.txt")
            HelpContents
        Case MCSEARCHHELP
            lblInfo.Caption = LoadText("helptext.txt")
            HelpSearch
        Case MCABOUT
            lblInfo.Caption = LoadText("about.txt")
            ModalForm RUFAboutForm
        'toggle registered flag: bReg
        Case MCSWV
            If bReg Then
                helpMenu(MCSWV).Checked = True
                bReg = False
            Else
                helpMenu(MCSWV).Checked = False
                bReg = True
            End If
        Case MCOTHER
            lblInfo.Caption = LoadText("other.txt")
    End Select
End Sub